home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
clipper
/
rpcxlb10.zip
/
RPCXDEMO.PRG
< prev
next >
Wrap
Text File
|
1993-08-12
|
16KB
|
623 lines
*--------------------------------------------------------------------------
* RPCXDemo.PRG - Program to demonstrate the use of the functions
* in the graphic RPCXLib library for Clipper
*
* This demo has been written for Clipper version 5.xx
*
* Compile : CLIPPER RPCXDEMO /N
*
* Link : RTLINK file RPCXDEMO lib RPCXLIB - or -
* BLINKER file RPCXDEMO lib RPCXLIB
*
* Syntax : RPCXDEMO [d:][\path]
* [d:][\path] : directory where PCX-files are located
*--------------------------------------------------------------------------
* Date : 11/08/93
*--------------------------------------------------------------------------
* Author : Rolf van Gelder
* Binnenwiertzstraat 27
* 5615 HG EINDHOVEN
* THE NETHERLANDS
*
* E-Mail : Internet: RCROLF@urc.tue.nl
* BitNet : RCROLF@heitue5
*--------------------------------------------------------------------------
* (c) 1993 Rolf van Gelder - All rights reserved
*--------------------------------------------------------------------------
MEMVAR GetList && To eliminate Clipper /W warning
*--------------------------------------------------------------------------
* Standard Clipper HEADER files
*--------------------------------------------------------------------------
#include "Inkey.ch"
#include "AChoice.ch"
#include "SetCurs.ch"
#include "Directry.ch"
*--------------------------------------------------------------------------
* RPCXLIB HEADER FILE
*--------------------------------------------------------------------------
#include "RPCXLib.ch"
*--------------------------------------------------------------------------
* Static array (used by different functions)
*--------------------------------------------------------------------------
*-- Initialize the array with error messages (from RPCXLib.CH)
STATIC aPCXError := PL_ERRMSG
*--------------------------------------------------------------------------
*
* Main function : RPCXDemo
*
*--------------------------------------------------------------------------
FUNCTION R_PCXDemo ( cDrvPath )
LOCAL nSVGA := R_VGACard () && Number of SVGA card
LOCAL aDrivers := PL_SVGA_NAMES && Names of the SVGA cards
LOCAL cGraphDrv && Description SVGA card
LOCAL cGraphSys := 'UNKNOWN' && Description Graphic System
LOCAL cGraphMsg && Text buffer
LOCAL nFiles && Number of PCX-files in directory
LOCAL nBottom && Last line for AChoice window
LOCAL aPCXList := {} && Array with PCX-file info
LOCAL aValid := {} && Selectable items for AChoice
LOCAL aPCXDir := {} && Directory info PCX-files
LOCAL nChoice := 1 && Sequence number chosen file
LOCAL nLastKey && Keycode
LOCAL cFile && Name of PCX-file
LOCAL nVidMode := R_VMGet () && Original video mode
LOCAL nRetCode && Return code of R_ShowPCX
LOCAL cScreen && Screen buffer
LOCAL cSpec && Filespec PCX-file
LOCAL cComment && Comment on PCX-file
LOCAL i && Counter
LOCAL n && Help variable
LOCAL nRed && Red component
LOCAL nGreen && Green component
LOCAL nBlue && Blue component
LOCAL aBWhite := PL_DEF_BRIGHT_WHITE && Composition BRIGHT WHITE
LOCAL aWhite := PL_DEF_WHITE && Composition WHITE
LOCAL aYellow := PL_DEF_YELLOW && Composition YELLOW
LOCAL cPalette && Palette buffer
LOCAL cPalOrg := R_SavePal () && Save original palette
*-- Install the default Clipper palette (just to be sure ...)
R_DefPal ()
*-- Mix a special GREEN colour for the background :
*-- 5 x RED + 30 x GREEN + 30 x BLUE
R_SetRGB ( PL_GREEN, 5, 30, 30 )
*-- Determine the number of PCX-files in the current directory
IF cDrvPath != NIL
*-- Path passed as command line parameter
*-- Append a backslash (if needed)
cDrvPath := Trim ( cDrvPath )
IF Right ( cDrvPath, 1 ) != ':'
*-- Path has been given
IF Right ( cDrvPath, 1 ) != '\'
*-- Path doesn't end with a backslash : append !
cDrvPath += '\'
ENDIF
ENDIF
ELSE
*-- No drive nor path given
cDrvPath := ''
ENDIF
*-- Get the directory list of the PCX-files
aPCXDir := Directory ( cDrvPath + '*.PCX' )
nFiles := Len ( aPCXDir )
IF nFiles > 0
*-- PCX-files found !
FOR i := 1 TO nFiles
*-- Stuff the info of all the PCX-files in an array
AADD ( aValid , GetInfo (cDrvPath+aPCXDir[i,F_NAME], @cSpec, @cComment ) )
AADD ( aPCXList, PADR ( aPCXDir[i,F_NAME], 12 ) + ' │ ' + ;
Str ( aPCXDir[i,F_SIZE],6 ) + ' │ ' + ;
PADR ( cSpec, 16 ) + ' │ ' + PADR ( cComment, 33 ) )
NEXT
*-- Sort the array on file name
aPCXList := ASORT ( aPCXList )
ENDIF
IF nSVGA < 1
*-- SuperVGA unknown or not present !
*-- Determine the graphic system of the PC
IF R_IsMCGA ()
cGraphSys := 'MCGA'
ELSEIF R_IsVGA ()
cGraphSys := 'VGA'
ELSEIF R_IsEGA ()
cGraphSys := 'EGA'
ENDIF
ELSE
cGraphSys := 'SUPERVGA'
*-- Name of the SuperVGA adapter
cGraphDrv := aDrivers [nSVGA]
ENDIF
SETCOLOR ( 'W+/G' )
SETBLINK ( .t. )
CLEAR
*-- Header text
DEVPOS ( 1, 12 )
DEVOUT ( 'RPCXDemo : Demo program for the RPCXLib Clipper Library' )
SETCOLOR ( 'GR+/G' )
DEVPOS ( 2, 27 )
DEVOUT ( '(c) 1993 Rolf van Gelder' )
SETCOLOR ('W+/G')
IF nFiles < 1
*-- No PCX-files in current directory :
*-- Just show the graphic configuration
ALERT ( '-+- CONFIGURATION -+-;;;Graphic System: ' + cGraphSys + ;
IF ( cGraphDrv != nil, ';;;SVGA Adapter: ' + cGraphDrv, nil ) )
ALERT ( 'No PCX-files found !' )
RETURN nil
ENDIF
*-- Determine the height of the directory listbox
nBottom := Min ( nFiles+6, 16 )
DEVPOS ( nBottom+1, 11 )
DEVOUT ( '<─┘ = Show file -+- <F10> = SlideShow -+- <Esc> = Quit' )
@19,0 TO 22,79
DEVPOS ( 20, 2 )
DEVOUT ( 'MIX BACKGROUND COLOUR Current values : RED 5'+;
' - GREEN 30 - BLUE 30' )
DEVPOS ( 21, 2 )
DEVOUT ( 'F1=RED F2=RED F3=GREEN F4=GREEN '+;
'F5=BLUE F6=BLUE ' )
@4,0 TO nBottom,79 DOUBLE
SETCOLOR ( 'GR+/G' )
@5,2 SAY 'File name │ Bytes │ Width Height Col │ Video mode / Comment '
*-- Display the graphic configuration on line 23
cGraphMsg := '-+- Graphic System : '+cGraphSys
IF cGraphDrv != nil
cGraphMsg += ' -+- SVGA Adapter : '+cGraphDrv
ENDIF
cGraphMsg += ' -+-'
@23, ( 80 - LEN ( cGraphMsg ) ) / 2 SAY cGraphMsg
SETCOLOR ( 'W+/G,W+/R,,,W/G' )
cScreen := SAVESCREEN ( 0, 0, MAXROW(), MAXCOL() )
*----------------------------------------------------------------
* Main loop for displaying pictures and changing the background
* colour
*----------------------------------------------------------------
DO WHILE .T.
nChoice := ACHOICE ( 6, 2, nBottom-1, 77, aPCXList, ;
aValid, 'AchUser', nChoice )
nLastKey := LASTKEY ()
DO CASE
CASE nLastKey = K_ESC
*-- Quit
EXIT
CASE nLastKey = K_RETURN
*-- SHOW CHOSEN FILE
*-- File name PCX-file
cFile := cDrvPath + TRIM ( LEFT ( aPCXList [nChoice], 12 ) )
*-- Save current palette to a string
cPalette := R_SavePal ()
*-- Show the PCX-file on the screen
nRetCode := R_ShowPCX ( cFile )
IF nRetCode = PL_OKAY
*-- It went okay !
*-- Show the picture 10 seconds (interruptible)
INKEY ( 10 )
*-- Restore original video mode
R_VMSet ( nVidMode )
ENDIF
*-- Restore original palette
*-- (Palette has been reset by R_VMSet () ....)
R_RestPal ( cPalette )
*-- Repaint the screen
RESTSCREEN ( 0, 0, MAXROW(), MAXCOL(), cScreen )
IF nRetCode != PL_OKAY
*-- Error while displaying PCX-file : display error message
ALERT ('-+- Error displaying '+cFile+' -+-;;'+;
aPCXError[nRetCode])
ENDIF
CASE nLastKey = K_F10
*-- Slid